library(twitteR)
library(tidyverse)
library(tidytext)
library(lubridate)
library(magrittr)
library(xts)
library(dygraphs)
library(reshape2)
library(TTR)
library(imputeTS)
library(readxl)
library(janitor)
library(SnowballC)
library(tm)
library(syuzhet)
library(kableExtra)
library(plotly)
library(wordcloud)
library(RColorBrewer)
Se cargan las funciones.
source("funciones/GetData.R")
source("funciones/codigosCOVID.R")
source("funciones/CleanAndSelect.R")
source("funciones/customWC.R")
source("funciones/plotSentimientos.R")
Se crean las carpetas data y tablas para guardar los datos crudos y tidy, repectivamente.
if(!file.exists("data")){
dir.create(("data"))
}
if(!file.exists("tidyTablas")){
dir.create(("tidyTablas"))
}
Para este análisis de sentimientos se utilizó una traducción del léxico Afinn; éste, es un conjunto de palabras con puntuación entre -4 y -1 si son percibidas de forma negativa y entre 1 y 4 si se perciben positivamente. El léxico se descargó [aquí] (https://raw.githubusercontent.com/jboscomendoza/rpubs/master/sentimientos_afinn/lexico_afinn.en.es.csv); aunque tiene sus limitaciones, cumple con uno de los propósitos de éste proyecto.
# Descarga el archivo
download.file("https://raw.githubusercontent.com/jboscomendoza/rpubs/master/sentimientos_afinn/lexico_afinn.en.es.csv", "data/lexico_afinn.en.es.csv")
Se lee el léxico afinn y se agrega la palabra COVID con puntuación negativa (-4).
afinn <- read.csv("data/lexico_afinn.en.es.csv",
stringsAsFactors = F,
fileEncoding = "latin1") %>%
as_tibble()
# Se agrega COVID al conjunto afinn
palabras.covid <- data.frame("covid", -4, "covid")
colnames(palabras.covid) <- c("Palabra", "Puntuacion", "Word")
afinn <- rbind(afinn, palabras.covid)
Las claves: consumer_key (CK), consumer_secret (CS), access_token (AT) y access_secret (AS) se obtienen en https://apps.twitter.com/app.
#https://apps.twitter.com/app/9399375/keys
CK <- "consumer_key"
CS<- "consumer_secret"
AT<- "access_token"
AS<- "access_secret"
setup_twitter_oauth(CK, CS, AT, AS)
Se crea un vector con los usuarios que se analizarán y la cantidad de tweets a descargar.
usuarios <-c("ClaudiaPavlovic", "lopezobrador_", "CelidaLopezc",
"HLGatell", "Enrique_Clausen")
num.tweets <- 1000
Con la función GetData se obtienen los últimos estados publicados en twitter para la lista de usuarios.
# Descarga de datos
df.tweet <- GetData(usuarios, num.tweets)
# Guarda un archivo csv
write.csv(df.tweet, "data/df.tweet.csv")
Se limpian los datos con la función CleanAndSelect.
usuarios <- c("ClaudiaPavlovic", "lopezobrador_", "CelidaLopezc")
# Se leen los datos descargados
df.tweet <- read.csv("data/df.tweet.csv")
# limpieza de datos
df.tweet <- CleanAndSelect(df.tweet, vecUser = usuarios)
Limpieza y tokenización de los datos.
df.palabras <- df.tweet %>%
# tokenización
unnest_tokens(input = "text", output = "Palabra")%>%
right_join(afinn, ., by = "Palabra") %>%
# Las palabras se clasifican en positiva y negativa
mutate(Tipo = ifelse(Puntuacion > 0, "Positiva", "Negativa"))
Para descartar algunas palabras en plural, si la última letra de la palabra es s, se elimina; además, se reemplaza la palabra enfermedades por enfermedad.
df.palabras$Palabra <- df.palabras$Palabra %>%
str_replace_all("s$", "") %>%
str_replace_all("enfermedades", "enfermedad")
Se crea un data frame donde se asignan los puntos de cada palabra, de cada tweet.
df.tweet <- df.palabras %>%
group_by(id, Fecha, screenName) %>%
summarise(Puntuacion.tweet = sum(Puntuacion, na.rm = TRUE)) %>%
group_by(id) %>%
left_join(df.tweet, ., by = "id") %>%
select(id2 = id, Puntuacion.tweet) %>%
cbind(df.tweet)
Se cuenta la frecuencia de cada palabra y se descartan sí y no.
# Cantidad de palabras y palabras únicas
df.palabras %>%
group_by(screenName) %>%
summarise(n = n(), distintas = n_distinct(Palabra)) %>%
kbl() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
| screenName | n | distintas |
|---|---|---|
| CelidaLopezc | 3422 | 1144 |
| ClaudiaPavlovic | 11051 | 1883 |
| lopezobrador_ | 2970 | 1106 |
# se descartan las palabras sí y no
df.palabras <-
df.palabras %>%
filter(Palabra != "no") %>%
filter(Palabra != "sí")
write.csv(df.palabras, "tidyTablas/df.palabras.csv")
Se grafica el top 10 de palabras.
map(c("Positiva", "Negativa"), plotSentimientos)
## [[1]]
##
## [[2]]
Se muestran las 100 palabras más comunes por usuario.
Andrés Manuel López Obrador
customWC("lopezobrador_", df.palabras)
Claudia Pavlovich Arellano
customWC("ClaudiaPavlovic", df.palabras)
Célida López Cárdenas
customWC("CelidaLopezc", df.palabras)
df.tweet.date <- df.tweet %>%
group_by(screenName, Fecha) %>%
summarise(Media = mean(Puntuacion.tweet)) %>%
dcast(Fecha ~ screenName)
write.csv(df.tweet.date, "tidyTablas/df.tweet.date.csv")
xts.tweet.date <- xts(df.tweet.date %>%
select(-Fecha),
order.by = df.tweet.date$Fecha)
dygraph(xts.tweet.date) %>%
dyOptions(fillGraph=TRUE, pointShape = "ex")
# Interpolar datos
df.interpolado <- df.tweet.date %>%
transmute(AMLO = na_interpolation(lopezobrador_),
CPA = na_interpolation(ClaudiaPavlovic),
CLC = na_interpolation(CelidaLopezc)) %>%
cbind(Fecha = df.tweet.date$Fecha)
# Guardar como xts
xts.interpolado <- xts(df.interpolado %>%
select(-Fecha),
order.by = df.interpolado$Fecha)
dygraph(xts.interpolado) %>%
dyOptions(fillGraph = TRUE, pointShape = "ex") %>%
dyRangeSelector()
nSMA <- 10
df.SMA <- df.interpolado %>%
transmute(AMLO.SMA = SMA(AMLO, n = nSMA),
CPA.SMA = SMA(CPA, n = nSMA),
CLC.SMA = SMA(CLC, n = nSMA)) %>%
cbind(Fecha = df.tweet.date$Fecha)
df.SMA %>%
filter(Fecha >1) -> fecha.min
fecha.min <- fecha.min$Fecha
df.SMA <- df.SMA %>%
filter(Fecha >= fecha.min)
xts.SMA <- xts(df.SMA %>%
select(-Fecha),
order.by = df.SMA$Fecha)
dygraph(xts.SMA) %>%
dyOptions(fillGraph = TRUE, pointShape = "ex") %>%
dyRangeSelector()
Los datos de COVID-19 se tomaron de [datos abiertos] (https://datos.gob.mx/).
Se descarga el archivo
# liga del archivo de covid
filename <- "http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip"
# Descarga el archivo
download.file(filename, "data/datos_abiertos_covid.zip")
La lectura se puede llevar a cabo de dos formas:
# Descomprime el archivo
df.covid0 <- unzip("data/datos_abiertos_covid.zip", exdir = "data") %>%
read.csv() %>%
clean_names()
df.covid0 <- read.csv("data/201214COVID19MEXICO.csv") %>%
clean_names()
Se seleccionan las variables de interés de los casos confirmados.
df.covid <- df.covid0 %>%
# Se seleccionan las variables de interés
select(id_registro, fecha_ingreso,
entidad_res, municipio_res, clasificacion_final) %>%
# Se seleccionan los casos confirmados
filter(clasificacion_final <= 3) %>%
# Se cambian valores numéricos por su descriptor
codigosCOVID()
# Formato fecha
df.covid$fecha_ingreso %<>% ymd()
df.covid <- df.covid %>%
# Se crea variable auxiliar para contar confirmados en Sonora
mutate(conf.sonora = ifelse(entidad_res == 26, 1, 0),
conf.hmo = ifelse(municipio == "Hermosillo" & entidad_res == 26, 1, 0))
Se crea un data frame con los casos confirmados en el país, estado y municipio.
resumen.covid <- df.covid %>%
mutate(Fecha = fecha_ingreso) %>%
select(Fecha, conf.sonora, conf.hmo) %>%
group_by(Fecha) %>%
summarise(confirmados.Nacional = n(),
confirmados.Sonora = sum(conf.sonora),
confirmados.Hermosillo = sum(conf.hmo))
Se combinan los data frame de twitter y de COVID-19.
df <- resumen.covid %>%
left_join(df.tweet.date, by = "Fecha") %>%
filter(Fecha >= min(df.tweet$Fecha))
# Guarda archivo
write.csv(df, "tidyTablas/df.csv")
lm.AMLO <- lm(data = df, lopezobrador_ ~ confirmados.Nacional)
summary(lm.AMLO)
##
## Call:
## lm(formula = lopezobrador_ ~ confirmados.Nacional, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -16.0999 -0.5621 0.0328 0.9540 8.1604
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.5511454 0.6729883 0.819 0.415
## confirmados.Nacional -0.0000911 0.0001069 -0.852 0.396
##
## Residual standard error: 2.835 on 104 degrees of freedom
## (3 observations deleted due to missingness)
## Multiple R-squared: 0.006929, Adjusted R-squared: -0.002619
## F-statistic: 0.7257 on 1 and 104 DF, p-value: 0.3962
fig <- plot_ly(data = df,
x = ~confirmados.Nacional,
y = ~lopezobrador_,
marker = list(size = 10,
color = 'lightskyblue',
line = list(color = 'blue',
width = 1)))
fig
## Warning: Ignoring 3 observations
## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
##
## Pearson's product-moment correlation
##
## data: df$confirmados.Nacional and df$lopezobrador_
## t = -0.85188, df = 104, p-value = 0.3962
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2697160 0.1092467
## sample estimates:
## cor
## -0.08324343
lm.CPA <- lm(data = df, ClaudiaPavlovic ~ confirmados.Sonora)
summary(lm.CPA)
##
## Call:
## lm(formula = ClaudiaPavlovic ~ confirmados.Sonora, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4545 -0.6689 0.0602 0.7737 2.5538
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.455e-01 2.413e-01 -2.261 0.0258 *
## confirmados.Sonora -7.046e-05 1.400e-03 -0.050 0.9600
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.2 on 105 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 2.411e-05, Adjusted R-squared: -0.009499
## F-statistic: 0.002532 on 1 and 105 DF, p-value: 0.96
fig <- plot_ly(data = df,
x = ~confirmados.Sonora,
y = ~ClaudiaPavlovic,
marker = list(size = 10,
color = 'darkseagreen',
line = list(color = 'green',
width = 1)))
fig
## Warning: Ignoring 2 observations
cor.test(df$confirmados.Sonora, df$ClaudiaPavlovic)
##
## Pearson's product-moment correlation
##
## data: df$confirmados.Sonora and df$ClaudiaPavlovic
## t = -0.050317, df = 105, p-value = 0.96
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1945874 0.1851206
## sample estimates:
## cor
## -0.004910353
lm.CLC <- lm(data = df, CelidaLopezc ~ confirmados.Hermosillo)
summary(lm.CLC)
##
## Call:
## lm(formula = CelidaLopezc ~ confirmados.Hermosillo, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.0966 -0.9328 0.1682 1.1502 3.3204
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.793463 0.422659 4.243 8.35e-05 ***
## confirmados.Hermosillo -0.013937 0.004872 -2.861 0.00593 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.726 on 56 degrees of freedom
## (51 observations deleted due to missingness)
## Multiple R-squared: 0.1275, Adjusted R-squared: 0.1119
## F-statistic: 8.184 on 1 and 56 DF, p-value: 0.005929
fig <- plot_ly(data = df,
x = ~confirmados.Hermosillo,
y = ~CelidaLopezc,
marker = list(size = 10,
color = 'indianred',
line = list(color = 'darkred',
width = 1)))
fig
## Warning: Ignoring 51 observations
##
## Pearson's product-moment correlation
##
## data: df$confirmados.Hermosillo and df$CelidaLopezc
## t = -2.8608, df = 56, p-value = 0.005929
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.5634180 -0.1088311
## sample estimates:
## cor
## -0.3570889
Datos de COVID19 descargados en:
https://www.gob.mx/salud/documentos/datos-abiertos-152127
Para imputar datos:
https://towardsdatascience.com/how-to-handle-missing-data-8646b18db0d4
Ejemplos de análisis de sentimientos en twitter:
https://rpubs.com/Joaquin_AR/334526
https://rpubs.com/jboscomendoza/analisis_sentimientos_lexico_afinn